unit uMessages;

(***********************************************************

Advanced messaging

***********************************************************)


{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, contnrs, LMessages, uTypes, uInterfaces;

const
    ISM_RESERVED = $0000;
    ISM_GENERAL = $1000;
    ISM_KEYBOARD = $2000;
    ISM_MOUSE = $3000;
    ISM_BROWSER = $4000;

    ISM_USER = $F000;

    ISM_BROWSER_INFO = ISM_BROWSER + $0001;
    ISM_BROWSER_INFO_ADDRESS = ISM_BROWSER + $0002;
    ISM_BROWSER_INFO_CAPTION = ISM_BROWSER + $0003;

    // Temporary

    ISM_TMP_TEXT                    = LM_USER + $A9;
    ISM_TMP_BRW_STATUS              = LM_USER + $AA;
    ISM_TMP_BRW_RESOURCE            = LM_USER + $AB;
    ISM_TMP_BRW_HINT                = LM_USER + $AC;
    ISM_TMP_BRW_LOG                 = LM_USER + $AD;
    ISM_TMP_BRW_POPUP               = LM_USER + $AE;
    ISM_TMP_BRW_POPUP_BACKGROUND    = LM_USER + $AF;
    ISM_TMP_BRW_LOAD_URL            = LM_USER + $B0;
    ISM_TMP_BRW_ADDRESS             = LM_USER + $B1;

    // Submessages


type
    // Base class for IS messages

    { TISMessage }

    TISMessage = class(TISInterfacedObject, IISMessage)
    private
        FMsgType: TISMessageType;
        FMsg: cardinal;
        FOwned: boolean;
        FResult: TISMessageResult;
        FTarget: IISMessageTarget;
        function GetMsg: cardinal;
        function GetMsgType: TISMessageType;
        function GetResult: TISMessageResult;
        function GetTarget: IISMessageTarget;
        procedure SetMsgType(AValue: TISMessageType);
        procedure SetMsg(AValue: cardinal);
        procedure SetOwned(AValue: boolean);
        procedure SetResult(AValue: TISMessageResult);
        procedure SetTarget(AValue: IISMessageTarget);
    protected
        procedure Init; virtual;
    public
        constructor Create;
        property MsgType: TISMessageType read GetMsgType write SetMsgType;
        property Msg: cardinal read GetMsg write SetMsg;
        property Result: TISMessageResult read GetResult write SetResult;

        // Target of the message. If nil then message will be broadcasted
        property Target: IISMessageTarget read GetTarget write SetTarget;

        // Only sender can destroy this message
        property Owned: boolean read FOwned write SetOwned;
    end;

    TISMessageClass = class of TISMessage;

    { TISMesageBrowser }

    TISMesageBrowser = class(TISMessage)
    protected
        procedure Init; override;
    public
    end;

    { TISMesageBrowserInfo }

    TISMesageBrowserInfo = class(TISMesageBrowser)
    private
        FText: string;
        procedure SetText(AValue: string);
    protected
        procedure Init; override;
    public
        property Text: string read FText write SetText;
    end;

    // IS message queue

    { TISMessageQueue }

    TISMessageQueue = class(TObjectQueue)
    private
    protected
    public
        function PushMsg(AMsg: TISMessage): TISMessage; overload;
        function PushMsg(const AMsgType: TISMessageType; const AMsg: cardinal;
            AMsgClass: TISMessageClass): TISMessage; overload;
        function PopMsg: TISMessage;
        function PeekMsg: TISMessage;
    end;

implementation

{ TISMesageBrowserInfo }

procedure TISMesageBrowserInfo.SetText(AValue: string);
begin
    if FText = AValue then
        Exit;
    FText := AValue;
end;

procedure TISMesageBrowserInfo.Init;
begin
    inherited Init;
end;

{ TISMesageBrowser }

procedure TISMesageBrowser.Init;
begin
    inherited Init;
    MsgType := msgBrowser;
end;

{ TISMessageQueue }

function TISMessageQueue.PushMsg(AMsg: TISMessage): TISMessage;
begin
    Push(AMsg);
    Result := AMsg;
end;

function TISMessageQueue.PushMsg(const AMsgType: TISMessageType; const AMsg: cardinal;
    AMsgClass: TISMessageClass): TISMessage;
begin
    Result := PushMsg(TISMessageClass.Create);
    Result.MsgType := AMsgType;
    Result.Msg := AMsg;
    Result.Result := msrNone;
end;

function TISMessageQueue.PopMsg: TISMessage;
begin
    Result := Pop as TISMessage;
end;

function TISMessageQueue.PeekMsg: TISMessage;
begin
    Result := Peek as TISMessage;
end;

{ TISMessage }

procedure TISMessage.SetMsgType(AValue: TISMessageType);
begin
    if FMsgType = AValue then
        Exit;
    FMsgType := AValue;
end;

function TISMessage.GetMsg: cardinal;
begin
    Result := FMsg;
end;

function TISMessage.GetMsgType: TISMessageType;
begin
    Result := FMsgType;
end;

function TISMessage.GetResult: TISMessageResult;
begin
    Result := FResult;
end;

function TISMessage.GetTarget: IISMessageTarget;
begin
    Result := FTarget;
end;

procedure TISMessage.SetMsg(AValue: cardinal);
begin
    if FMsg = AValue then
        Exit;
    FMsg := AValue;
end;

procedure TISMessage.SetOwned(AValue: boolean);
begin
    if FOwned = AValue then
        Exit;
    FOwned := AValue;
end;

procedure TISMessage.SetResult(AValue: TISMessageResult);
begin
    if FResult = AValue then
        Exit;
    FResult := AValue;
end;

procedure TISMessage.SetTarget(AValue: IISMessageTarget);
begin
    FTarget := AValue;
end;

procedure TISMessage.Init;
begin
    Msg := ISM_RESERVED;
end;

constructor TISMessage.Create;
begin
    inherited;
    Init;
end;

end.
